Data loading

dip <- read.csv("~/Desktop/dip.csv")
cs <- read.csv("~/Desktop/cs.csv")

Set Up

library(dplyr)
## 
## Attaching package: 'dplyr'
## 
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## 
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(tidyr)
library(ade4)
library(adegraphics)
## 
## Attaching package: 'adegraphics'
## 
## The following objects are masked from 'package:ade4':
## 
##     kplotsepan.coa, s.arrow, s.class, s.corcircle, s.distri,
##     s.image, s.label, s.logo, s.match, s.traject, s.value,
##     table.value, triangle.class
library(ggplot2)

Data content

head(cs)
##   region dep                  libdep wave   ids        idt    pop
## 1     82  01                     Ain 1968 82_01 82_01_1968  89180
## 2     22  02                   Aisne 1968 22_02 22_02_1968 115968
## 3     83  03                  Allier 1968 83_03 83_03_1968  90240
## 4     93  04 Alpes-de-Haute-Provence 1968 93_04 93_04_1968  24600
## 5     93  05            Hautes-Alpes 1968 93_05 93_05_1968  22808
## 6     93  06         Alpes-Maritimes 1968 93_06 93_06_1968 178236
##       p_cs1     p_cs2    p_cs3    p_cs4    p_cs5    p_cs6
## 1 19.533530 11.751510 3.758690 11.28056 16.48800 37.18771
## 2  9.078366  9.716474 3.959713 13.10706 17.44274 46.69564
## 3 15.806740 11.728720 4.312943 12.07890 18.86082 37.21188
## 4 13.528460 14.000000 5.756098 13.86992 17.07317 35.77236
## 5 19.729920 13.170820 5.559453 12.92529 19.69484 28.91968
## 6  3.456092 16.214460 7.199443 12.74041 26.68148 33.70812
head(dip)
##   region dep                  libdep wave   ids        idt    pop   p_dip0
## 1     82  01                     Ain 1968 82_01 82_01_1968  89180 36.33102
## 2     22  02                   Aisne 1968 22_02 22_02_1968 115968 40.22834
## 3     83  03                  Allier 1968 83_03 83_03_1968  90240 33.03635
## 4     93  04 Alpes-de-Haute-Provence 1968 93_04 93_04_1968  24600 36.86179
## 5     93  05            Hautes-Alpes 1968 93_05 93_05_1968  22808 32.88320
## 6     93  06         Alpes-Maritimes 1968 93_06 93_06_1968 178236 35.44738
##     p_dip1   p_dip2   p_dip3   p_dip4   p_dip7
## 1 37.26844 3.740749 12.93115 6.310832 3.417807
## 2 33.73344 3.338852 12.43791 6.857064 3.404387
## 3 37.79255 4.485816 12.55762 8.280142 3.847518
## 4 32.16260 5.739837 11.02439 7.804878 6.406504
## 5 37.82883 5.243774 11.60996 7.821817 4.612417
## 6 29.71566 6.712449 12.28932 9.461613 6.373572

Formatting

cs$wave <- as.factor(cs$wave)
dip$wave <- as.factor(dip$wave)

cs$region <- as.factor(cs$region)
dip$region <- as.factor(dip$region)

Selecting subsets

cs68 <- filter(cs, wave=="1968")
cs75 <- filter(cs, wave=="1975")
cs82 <- filter(cs, wave=="1982")
cs90 <- filter(cs, wave=="1990")
cs99 <- filter(cs, wave=="1999")
cs06 <- filter(cs, wave=="2006")
cs11 <- filter(cs, wave=="2011")
cs68i <- select(cs68, p_cs1:p_cs6)
cs75i <- select(cs75, p_cs1:p_cs6)
cs82i <- select(cs82, p_cs1:p_cs6)
cs90i <- select(cs90, p_cs1:p_cs6)
cs99i <- select(cs99, p_cs1:p_cs6)
cs06i <- select(cs06, p_cs1:p_cs6)
cs11i <- select(cs11, p_cs1:p_cs6)

Scaling

wcs68 <- data.frame(scalewt(cs68i))
wcs75 <- data.frame(scalewt(cs75i))
wcs82 <- data.frame(scalewt(cs82i))
wcs90 <- data.frame(scalewt(cs90i))
wcs99 <- data.frame(scalewt(cs99i))
wcs06 <- data.frame(scalewt(cs06i))
wcs11 <- data.frame(scalewt(cs11i))

wcs68s <- data.frame(scalewt(cs68i, wt=cs68$pop))
wcs75s <- data.frame(scalewt(cs75i, wt=cs75$pop))
wcs82s <- data.frame(scalewt(cs82i, wt=cs82$pop))
wcs90s <- data.frame(scalewt(cs90i, wt=cs90$pop))
wcs99s <- data.frame(scalewt(cs99i, wt=cs99$pop))
wcs06s <- data.frame(scalewt(cs06i, wt=cs06$pop))
wcs11s <- data.frame(scalewt(cs11i, wt=cs11$pop))

Check up

head(cs68)
##   region dep                  libdep wave   ids        idt    pop
## 1     82  01                     Ain 1968 82_01 82_01_1968  89180
## 2     22  02                   Aisne 1968 22_02 22_02_1968 115968
## 3     83  03                  Allier 1968 83_03 83_03_1968  90240
## 4     93  04 Alpes-de-Haute-Provence 1968 93_04 93_04_1968  24600
## 5     93  05            Hautes-Alpes 1968 93_05 93_05_1968  22808
## 6     93  06         Alpes-Maritimes 1968 93_06 93_06_1968 178236
##       p_cs1     p_cs2    p_cs3    p_cs4    p_cs5    p_cs6
## 1 19.533530 11.751510 3.758690 11.28056 16.48800 37.18771
## 2  9.078366  9.716474 3.959713 13.10706 17.44274 46.69564
## 3 15.806740 11.728720 4.312943 12.07890 18.86082 37.21188
## 4 13.528460 14.000000 5.756098 13.86992 17.07317 35.77236
## 5 19.729920 13.170820 5.559453 12.92529 19.69484 28.91968
## 6  3.456092 16.214460 7.199443 12.74041 26.68148 33.70812
head(cs68i)
##       p_cs1     p_cs2    p_cs3    p_cs4    p_cs5    p_cs6
## 1 19.533530 11.751510 3.758690 11.28056 16.48800 37.18771
## 2  9.078366  9.716474 3.959713 13.10706 17.44274 46.69564
## 3 15.806740 11.728720 4.312943 12.07890 18.86082 37.21188
## 4 13.528460 14.000000 5.756098 13.86992 17.07317 35.77236
## 5 19.729920 13.170820 5.559453 12.92529 19.69484 28.91968
## 6  3.456092 16.214460 7.199443 12.74041 26.68148 33.70812
head(wcs68)
##         p_cs1      p_cs2      p_cs3       p_cs4      p_cs5       p_cs6
## 1  0.33204827  0.4539412 -0.5862110 -0.48896057 -0.4278025  0.03251770
## 2 -0.67157077 -0.6534251 -0.4921549  0.14777336 -0.2052763  1.59683781
## 3 -0.02569623  0.4415400 -0.3268830 -0.21065224  0.1252431  0.03649434
## 4 -0.24439440  1.6774587  0.3483511  0.41371304 -0.2914139 -0.20034692
## 5  0.35090027  1.2262598  0.2563434  0.08440674  0.3196325 -1.32780423
## 6 -1.21126783  2.8824588  1.0236741  0.01995595  1.9480455 -0.53997207
head(wcs68s)
##        p_cs1      p_cs2      p_cs3       p_cs4      p_cs5       p_cs6
## 1  0.8215989  0.8300325 -0.7961548 -0.88364073 -0.7314912 -0.03459266
## 2 -0.2038653 -0.2327636 -0.7350694 -0.33042653 -0.5651168  1.39010883
## 3  0.4560676  0.8181305 -0.6277324 -0.64183782 -0.3180000 -0.03097094
## 4  0.2326092  2.0043048 -0.1891969 -0.09936987 -0.6295186 -0.24667366
## 5  0.8408613  1.5712661 -0.2489519 -0.38548141 -0.1726625 -1.27350320
## 6 -0.7553096  3.1608049  0.2493964 -0.44147826  1.0448400 -0.55598660

Labelling rows

row.names(cs68i) <- cs68$dep
row.names(cs75i) <- cs75$dep
row.names(cs82i) <- cs82$dep
row.names(cs90i) <- cs90$dep
row.names(cs99i) <- cs99$dep
row.names(cs06i) <- cs06$dep
row.names(cs11i) <- cs11$dep

row.names(wcs68) <- cs68$dep
row.names(wcs75) <- cs75$dep
row.names(wcs82) <- cs82$dep
row.names(wcs90) <- cs90$dep
row.names(wcs99) <- cs99$dep
row.names(wcs06) <- cs06$dep
row.names(wcs11) <- cs11$dep

row.names(wcs68s) <- cs68$dep
row.names(wcs75s) <- cs75$dep
row.names(wcs82s) <- cs82$dep
row.names(wcs90s) <- cs90$dep
row.names(wcs99s) <- cs99$dep
row.names(wcs06s) <- cs06$dep
row.names(wcs11s) <- cs11$dep

Building K-tables

lcs  <- list(cs68i, cs75i, cs82i, cs90i, cs99i, cs06i, cs11i)
lwcs <- list(wcs68, wcs75, wcs82, wcs90, wcs99, wcs06, wcs11)
lwcss <- list(wcs68s, wcs75s, wcs82s, wcs90s, wcs99s, wcs06s, wcs11s)

kcs <- ktab.list.df(lcs)
kwcs <- ktab.list.df(lwcs)
kwcss <- ktab.list.df(lwcss)

PTA - 1

ptacs <- pta(kcs, scannf = FALSE, nf=2)
plot(ptacs)

ptawcs <- pta(kwcs, scannf = FALSE, nf=2)
plot(ptawcs)

ptawcss <- pta(kwcss, scannf = FALSE, nf=2)
plot(ptawcss)

s.class(ptawcss$Tli, cs$dep, col=rainbow(100))

s.traject(ptawcss$Tli, cs$dep, col=rainbow(100))

s.class(ptawcss$Tli, cs$dep)

s.traject(ptawcss$Tli, cs$dep)

MCOA - 1

mcoacs <- mcoa(kcs, scannf = FALSE, nf=2)
plot(mcoacs)

mcoawcs <- mcoa(kwcs, scannf = FALSE, nf=2)
plot(mcoawcs)

mcoawcss <- mcoa(kwcss, scannf = FALSE, nf=2)
plot(mcoawcss)

Graphique

s.class(mcoawcss$Tli, cs$dep, col=rainbow(100))

s.traject(mcoawcss$Tli, cs$dep, col=rainbow(100))

s.class(mcoawcss$Tli, cs$dep)

s.traject(mcoawcss$Tli, cs$dep)

MFA - 1

mfacs <- mfa(kcs, scannf=FALSE, nf=2)
plot(mfacs)

mfawcs <- mfa(kwcs, scannf = FALSE, nf=2)
plot(mfawcs)

mfawcss <- mfa(kwcss, scannf = FALSE, nf=2)
plot(mfawcss)

s.class(mfawcss$lisup, cs$dep, col=rainbow(100))

s.traject(mfawcss$lisup, cs$dep, col=rainbow(100))

s.class(mfawcss$lisup, cs$dep)

s.traject(mfawcss$lisup, cs$dep)

Statis - 1

statiscs <- statis(kcs,  scannf = FALSE, nf = 2)
## Warning in sqrt(eig1$values): production de NaN
plot(statiscs)

statiswcs <- statis(kwcs,  scannf = FALSE, nf = 2)
## Warning in sqrt(eig1$values): production de NaN
plot(statiswcs)

statiswcss <- statis(kwcss,  scannf = FALSE, nf = 2)
plot(statiswcss)

Filtering The Second Data Frame

dip68 <- filter(dip, wave=="1968")
dip75 <- filter(dip, wave=="1975")
dip82 <- filter(dip, wave=="1982")
dip90 <- filter(dip, wave=="1990")
dip99 <- filter(dip, wave=="1999")
dip06 <- filter(dip, wave=="2006")
dip11 <- filter(dip, wave=="2011")

Select (2)

dip68i <- select(dip68, p_dip0:p_dip7)
dip75i <- select(dip75, p_dip0:p_dip7)
dip82i <- select(dip82, p_dip0:p_dip7)
dip90i <- select(dip90, p_dip0:p_dip7)
dip99i <- select(dip99, p_dip0:p_dip7)
dip06i <- select(dip06, p_dip0:p_dip7)
dip11i <- select(dip11, p_dip0:p_dip7)

Scaling (2)

wdip68 <- data.frame(scalewt(dip68i))
wdip75 <- data.frame(scalewt(dip75i))
wdip82 <- data.frame(scalewt(dip82i))
wdip90 <- data.frame(scalewt(dip90i))
wdip99 <- data.frame(scalewt(dip99i))
wdip06 <- data.frame(scalewt(dip06i))
wdip11 <- data.frame(scalewt(dip11i))

wdip68s <- data.frame(scalewt(dip68i, wt=dip68$pop))
wdip75s <- data.frame(scalewt(dip75i, wt=dip75$pop))
wdip82s <- data.frame(scalewt(dip82i, wt=dip82$pop))
wdip90s <- data.frame(scalewt(dip90i, wt=dip90$pop))
wdip99s <- data.frame(scalewt(dip99i, wt=dip99$pop))
wdip06s <- data.frame(scalewt(dip06i, wt=dip06$pop))
wdip11s <- data.frame(scalewt(dip11i, wt=dip11$pop))

Check up (2)

head(dip68)
##   region dep                  libdep wave   ids        idt    pop   p_dip0
## 1     82  01                     Ain 1968 82_01 82_01_1968  89180 36.33102
## 2     22  02                   Aisne 1968 22_02 22_02_1968 115968 40.22834
## 3     83  03                  Allier 1968 83_03 83_03_1968  90240 33.03635
## 4     93  04 Alpes-de-Haute-Provence 1968 93_04 93_04_1968  24600 36.86179
## 5     93  05            Hautes-Alpes 1968 93_05 93_05_1968  22808 32.88320
## 6     93  06         Alpes-Maritimes 1968 93_06 93_06_1968 178236 35.44738
##     p_dip1   p_dip2   p_dip3   p_dip4   p_dip7
## 1 37.26844 3.740749 12.93115 6.310832 3.417807
## 2 33.73344 3.338852 12.43791 6.857064 3.404387
## 3 37.79255 4.485816 12.55762 8.280142 3.847518
## 4 32.16260 5.739837 11.02439 7.804878 6.406504
## 5 37.82883 5.243774 11.60996 7.821817 4.612417
## 6 29.71566 6.712449 12.28932 9.461613 6.373572
head(dip68i)
##     p_dip0   p_dip1   p_dip2   p_dip3   p_dip4   p_dip7
## 1 36.33102 37.26844 3.740749 12.93115 6.310832 3.417807
## 2 40.22834 33.73344 3.338852 12.43791 6.857064 3.404387
## 3 33.03635 37.79255 4.485816 12.55762 8.280142 3.847518
## 4 36.86179 32.16260 5.739837 11.02439 7.804878 6.406504
## 5 32.88320 37.82883 5.243774 11.60996 7.821817 4.612417
## 6 35.44738 29.71566 6.712449 12.28932 9.461613 6.373572
head(wdip68)
##       p_dip0      p_dip1     p_dip2       p_dip3     p_dip4      p_dip7
## 1 -0.3117589  0.86483166 -0.5045600  0.198275334 -0.7674418 -0.57795462
## 2  0.3944159  0.06307504 -0.8375630  0.051757182 -0.3597962 -0.58486301
## 3 -0.9087365  0.98370257  0.1127861  0.087317331  0.7022277 -0.35674649
## 4 -0.2155860 -0.29319974  1.1518403 -0.368132402  0.3475446  0.96057727
## 5 -0.9364865  0.99193106  0.7408134 -0.194187397  0.3601859  0.03701089
## 6 -0.4718700 -0.84817863  1.9577251  0.007618158  1.5839435  0.94362442
head(wdip68s)
##        p_dip0      p_dip1     p_dip2     p_dip3      p_dip4     p_dip7
## 1  0.04243628  1.22195060 -0.7219622 -0.2281616 -1.01565223 -0.7737154
## 2  0.75948229  0.40286066 -1.0309806 -0.3883654 -0.66267381 -0.7782473
## 3 -0.56373154  1.34339139 -0.1490806 -0.3494838  0.25692779 -0.6286040
## 4  0.14008967  0.03888351  0.8151354 -0.8474752 -0.05019068  0.2355538
## 5 -0.59190875  1.35179778  0.4337128 -0.6572827 -0.03924459 -0.3703011
## 6 -0.12013968 -0.52809355  1.5629762 -0.4366273  1.02040149  0.2244328

Labelling (2)

row.names(dip68i) <- dip68$dep
row.names(dip75i) <- dip75$dep
row.names(dip82i) <- dip82$dep
row.names(dip90i) <- dip90$dep
row.names(dip99i) <- dip99$dep
row.names(dip06i) <- dip06$dep
row.names(dip11i) <- dip11$dep

row.names(wdip68) <- dip68$dep
row.names(wdip75) <- dip75$dep
row.names(wdip82) <- dip82$dep
row.names(wdip90) <- dip90$dep
row.names(wdip99) <- dip99$dep
row.names(wdip06) <- dip06$dep
row.names(wdip11) <- dip11$dep

row.names(wdip68s) <- dip68$dep
row.names(wdip75s) <- dip75$dep
row.names(wdip82s) <- dip82$dep
row.names(wdip90s) <- dip90$dep
row.names(wdip99s) <- dip99$dep
row.names(wdip06s) <- dip06$dep
row.names(wdip11s) <- dip11$dep

K - tables (2)

ldip <- list(dip68i, dip75i, dip82i, dip90i, dip99i, dip06i, dip11i)
lwdip <- list(wdip68, wdip75, wdip82, wdip90, wdip99, wdip06, wdip11)
lwdips <- list(wdip68s, wdip75s, wdip82s, wdip90s, wdip99s, wdip06s, wdip11s)

kdip <- ktab.list.df(ldip)
kwdip <- ktab.list.df(lwdip)
kwdips <- ktab.list.df(lwdips)

PTA (2)

ptadip <- pta(kdip, scannf = FALSE, nf = 2)
plot(ptadip)

ptawdip <- pta(kwdip, scannf = FALSE, nf = 2)
plot(ptawdip)

ptawdips <- pta(kwdips, scannf = FALSE, nf = 2)
plot(ptawdips)

s.class(ptawdips$Tli, dip$dep, col=rainbow(100))

s.traject(ptawdips$Tli, dip$dep, col=rainbow(100))

s.class(ptawdips$Tli, dip$dep)

s.traject(ptawdips$Tli, dip$dep)

MCOA (2)

mcoadip <- mcoa(kdip, scannf = FALSE, nf = 2)
plot(mcoadip)

mcoawdip <- mcoa(kwdip, scannf = FALSE, nf = 2)
plot(mcoawdip)

mcoawdips <- mcoa(kwdips, scannf = FALSE, nf = 2)
plot(mcoawdips)

s.class(mcoawdips$Tli, dip$dep, col=rainbow(100))

s.traject(mcoawdips$Tli, dip$dep, col=rainbow(100))

s.class(mcoawdips$Tli, dip$dep)

s.traject(mcoawdips$Tli, dip$dep)

MFA (2)

mfadip <- mfa(kdip, scannf = FALSE, nf = 2)
plot(mfadip)

mfawdip <- mfa(kwdip, scannf = FALSE, nf = 2)
plot(mfawdip)

mfawdips <- mfa(kwdips, scannf = FALSE, nf = 2)
plot(mfawdips)

s.class(mfawdips$lisup, dip$dep, col=rainbow(100))

s.traject(mfawdips$lisup, dip$dep, col=rainbow(100))

s.class(mfawdips$lisup, dip$dep)

s.traject(mfawdips$lisup, dip$dep)

STATIS (2)

statisdip <- statis(kdip, scannf = FALSE, nf = 2)
plot(statisdip)

statiswdip <- statis(kwdip, scannf = FALSE, nf = 2)
plot(statiswdip)

statiswdips <- statis(kwdips, scannf = FALSE, nf = 2)
plot(statiswdips)

STATICO

statico <- statico(kwcss, kwdips, scannf = FALSE)

plot(statico)

COSTATIS

costatis <- costatis(kwcss, kwdips, scannf = FALSE)

plot(costatis)

Combinaison :

x68 <- cbind(wcs68s, wdip68s)
x75 <- cbind(wcs75s, wdip75s)
x82 <- cbind(wcs82s, wdip82s)
x90 <- cbind(wcs90s, wdip90s)
x99 <- cbind(wcs99s, wdip99s)
x06 <- cbind(wcs06s, wdip06s)
x11 <- cbind(wcs11s, wdip11s)
lx <- list(x68, x75, x82, x90, x99, x06, x11)

kx <- ktab.list.df(lx)

PTA (4)

ptalx <- pta(kx, scannf = FALSE, nf = 2)
plot(ptalx)

s.class(ptalx$Tli, dip$dep, col=rainbow(100))

s.traject(ptalx$Tli, dip$dep, col=rainbow(100))

MCOA (4)

mcoalx <- mcoa(kx, scannf = FALSE, nf = 2)
plot(mcoalx)

s.class(mcoalx$Tli, dip$dep, col=rainbow(100))

s.traject(mcoalx$Tli, dip$dep, col=rainbow(100))

MFA (4)

mfalx <- mfa(kx, scannf = FALSE, nf = 2)
plot(mfalx)

s.class(mfalx$lisup, dip$dep, col=rainbow(100))

s.traject(mfalx$lisup, dip$dep, col=rainbow(100))

STATIS (4)

statislx <- statis(kx, scannf = FALSE, nf = 2)
## Warning in sqrt(eig1$values): production de NaN
plot(statiswdips)